Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH1/SRC/STYLES.FRM

Text File | 1996-05-04 | 14KB | 473 lines

VERSION 4.00
Begin VB.Form StyleForm
   Caption         =   "Styles"
   ClientHeight    =   4245
   ClientLeft      =   825
   ClientTop       =   1740
   ClientWidth     =   7935
   Height          =   4935
   Left            =   765
   LinkTopic       =   "Form1"
   ScaleHeight     =   4245
   ScaleWidth      =   7935
   Top             =   1110
   Width           =   8055
   Begin VB.Frame Frame1
      Caption         =   "FillStyle"
      Height          =   3135
      Index           =   2
      Left            =   1800
      TabIndex        =   15
      Top             =   1080
      Width           =   2055
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbDiagonalCross"
         Height          =   255
         Index           =   7
         Left            =   120
         TabIndex        =   23
         Top             =   2760
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbSolid"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   22
         Top             =   240
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "(Transparent)"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   21
         Top             =   600
         Value           =   -1  'True
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbHorizontalLine"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   20
         Top             =   960
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbVerticalLine"
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   19
         Top             =   1320
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbUpwardDiagonal"
         Height          =   255
         Index           =   4
         Left            =   120
         TabIndex        =   18
         Top             =   1680
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbCross"
         Height          =   255
         Index           =   6
         Left            =   120
         TabIndex        =   16
         Top             =   2400
         Width           =   1850
      End
      Begin VB.OptionButton FillStyleChoice
         Caption         =   "vbDownwardDiagonal"
         Height          =   255
         Index           =   5
         Left            =   120
         TabIndex        =   17
         Top             =   2040
         Width           =   1910
      End
   End
   Begin VB.TextBox WidthText
      Height          =   285
      Left            =   1920
      MaxLength       =   1
      TabIndex        =   14
      Text            =   "1"
      Top             =   720
      Width           =   375
   End
   Begin VB.Frame Frame1
      Caption         =   "DrawStyle"
      Height          =   3135
      Index           =   1
      Left            =   0
      TabIndex        =   2
      Top             =   1080
      Width           =   1695
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "vbInsideSolid"
         Height          =   255
         Index           =   6
         Left            =   120
         TabIndex        =   13
         Top             =   2400
         Width           =   1455
      End
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "(Transparent)"
         Height          =   255
         Index           =   5
         Left            =   120
         TabIndex        =   12
         Top             =   2040
         Width           =   1455
      End
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "vbDashDotDot"
         Height          =   255
         Index           =   4
         Left            =   120
         TabIndex        =   11
         Top             =   1680
         Width           =   1455
      End
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "vbDashDot"
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   10
         Top             =   1320
         Width           =   1455
      End
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "vbDot"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   9
         Top             =   960
         Width           =   1455
      End
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "vbDash"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   8
         Top             =   600
         Width           =   1455
      End
      Begin VB.OptionButton DrawStyleChoice
         Caption         =   "vbSolid"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Value           =   -1  'True
         Width           =   1455
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Object"
      Height          =   615
      Index           =   0
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   3855
      Begin VB.OptionButton ObjectChoice
         Caption         =   "Point"
         Height          =   255
         Index           =   3
         Left            =   2880
         TabIndex        =   24
         Top             =   240
         Width           =   735
      End
      Begin VB.OptionButton ObjectChoice
         Caption         =   "Box"
         Height          =   255
         Index           =   1
         Left            =   1200
         TabIndex        =   6
         Top             =   240
         Width           =   615
      End
      Begin VB.OptionButton ObjectChoice
         Caption         =   "Line"
         Height          =   255
         Index           =   0
         Left            =   360
         TabIndex        =   5
         Top             =   240
         Value           =   -1  'True
         Width           =   735
      End
      Begin VB.OptionButton ObjectChoice
         Caption         =   "Circle"
         Height          =   255
         Index           =   2
         Left            =   2040
         TabIndex        =   4
         Top             =   240
         Width           =   735
      End
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4215
      Left            =   3960
      ScaleHeight     =   4155
      ScaleWidth      =   3915
      TabIndex        =   0
      Top             =   0
      Width           =   3975
   End
   Begin VB.Label Label1
      Caption         =   "DrawWidth"
      Height          =   255
      Left            =   1080
      TabIndex        =   3
      Top             =   750
      Width           =   855
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "StyleForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Const OBJ_LINE = 0
Const OBJ_BOX = 1
Const OBJ_CIRCLE = 2
Const OBJ_POINT = 3

Dim Obj As Integer  ' The kind of object to draw.

Dim Rubberbanding As Boolean
Dim OldMode As Integer
Dim OldStyle As Integer
Dim FirstX As Single
Dim FirstY As Single
Dim LastX As Single
Dim LastY As Single



' ***********************************************
' Draw the final (non-rubberband) object.
' ***********************************************
Sub DrawObject()
    ' Pick a random fill color.
    Canvas.FillColor = QBColor(Int(Rnd * 16))

    ' Draw the object.
    Select Case Obj
        Case OBJ_LINE
            Canvas.Line (FirstX, FirstY)-(LastX, LastY)

        Case OBJ_BOX
            Canvas.Line (FirstX, FirstY)-(LastX, LastY), , B

        Case OBJ_CIRCLE
            Dim xmid As Single
            Dim ymid As Single
            Dim dx As Single
            Dim dy As Single
            Dim radius As Single

            xmid = (FirstX + LastX) / 2
            ymid = (FirstY + LastY) / 2
            dx = Abs(FirstX - LastX)
            dy = Abs(FirstY - LastY)
            If dx < dy Then
                radius = dx / 2
            Else
                radius = dy / 2
            End If
            Canvas.Circle (xmid, ymid), radius

        Case OBJ_POINT
            Canvas.PSet (LastX, LastY)

    End Select
End Sub

' ***********************************************
' Draw the appropriate kind of rubberband object.
' ***********************************************
Sub DrawRubberObject()
    Select Case Obj
        Case OBJ_LINE
            Canvas.Line (FirstX, FirstY)-(LastX, LastY)

        Case OBJ_BOX
            Canvas.Line (FirstX, FirstY)-(LastX, LastY), , B

        Case OBJ_CIRCLE
            Dim xmid As Single
            Dim ymid As Single
            Dim dx As Single
            Dim dy As Single
            Dim radius As Single

            xmid = (FirstX + LastX) / 2
            ymid = (FirstY + LastY) / 2
            dx = Abs(FirstX - LastX)
            dy = Abs(FirstY - LastY)
            If dx < dy Then
                radius = dx / 2
            Else
                radius = dy / 2
            End If
            Canvas.Circle (xmid, ymid), radius

        Case OBJ_POINT
            Canvas.PSet (LastX, LastY)

    End Select
End Sub


Private Sub DrawStyleChoice_Click(Index As Integer)
    Canvas.DrawStyle = Index
End Sub

Private Sub FillStyleChoice_Click(Index As Integer)
    Canvas.FillStyle = Index
End Sub


' ***********************************************
' Start a rubberbanding of some sort.
' ***********************************************
Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Let MouseMove know we are rubberbanding.
    Rubberbanding = True

    ' Save values so we can restore them later.
    OldMode = Canvas.DrawMode
    OldStyle = Canvas.DrawStyle
    Canvas.DrawMode = vbInvert
    If Obj = OBJ_LINE Then
        Canvas.DrawStyle = vbSolid
    Else
        Canvas.DrawStyle = vbDot
    End If

    ' Save the starting coordinates.
    FirstX = X
    FirstY = Y

    ' Save the ending coordinates.
    LastX = X
    LastY = Y

    ' Draw the appropriate rubberband object.
    DrawRubberObject
End Sub


' ***********************************************
' Continue rubberbanding.
' ***********************************************
Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If we are not rubberbanding, do nothing.
    If Not Rubberbanding Then Exit Sub

    ' Erase the previous rubberband object.
    DrawRubberObject

    ' Save the new ending coordinates.
    LastX = X
    LastY = Y

    ' Draw the new rubberband object.
    DrawRubberObject
End Sub

' ***********************************************
' Finish rubberbanding and draw the object.
' ***********************************************
Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If we are not rubberbanding, do nothing.
    If Not Rubberbanding Then Exit Sub

    ' We are no longer rubberbanding.
    Rubberbanding = False

    ' Erase the previous rubberband object.
    DrawRubberObject

    ' Restore the original DrawMode and DrawStyle.
    Canvas.DrawMode = OldMode
    Canvas.DrawStyle = OldStyle

    ' Draw the final object.
    DrawObject
End Sub


Private Sub Form_Load()
    ' Select the default options.
    DrawStyleChoice(Canvas.DrawStyle).Value = True
    FillStyleChoice(Canvas.FillStyle).Value = True
    ObjectChoice(Obj).Value = True
    WidthText.Text = Format$(Canvas.DrawWidth)
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

' ***********************************************
' Record the kind of object to draw next.
' ***********************************************
Private Sub ObjectChoice_Click(Index As Integer)
    Obj = Index
End Sub


' ***********************************************
' Change set DrawWidth.
' ***********************************************
Private Sub WidthText_Change()
Dim wid As Integer

    If Not IsNumeric(WidthText.Text) Then Exit Sub

    wid = CInt(WidthText.Text)
    If wid < 1 Then Exit Sub

    Canvas.DrawWidth = wid
End Sub

' ***********************************************
' Only allow 1 through 9.
' ***********************************************
Private Sub WidthText_KeyPress(KeyAscii As Integer)
    If KeyAscii < Asc(" ") Or _
       KeyAscii > Asc("~") Then Exit Sub
    If KeyAscii >= Asc("1") And _
       KeyAscii <= Asc("9") Then Exit Sub
    Beep
    KeyAscii = 0
End Sub